Developer CD Series 1996 January: Mac OS SDK/Dev.CD Jan 96 SDK/Dev.CD Jan 96 SDK1.toast/Development Kits (Disc 1)/AppleScript/Development Tools/Sample Code/7Edit/Pascal Sources/SVEditFile.p

Text File | 1994-02-25 | 19.6 KB | 752 lines | [TEXT/MPS ]

{[h-,k+,o=100,q+,r+,rec+,t=2,u+,:+,j=15/20/25/30/35/40/45/50/57/1$]} {Pasmat opts!}

UNIT SVEditFile;

(*
    SVEditFile.p

    Version 3.0d8

    Copyright © SRL Data 1992, 1993

    All rights reserved

    Produced by : SRL Data
    Originally Developed for UK.DTS
*)

(*
    File Handling routines for the SVEdit example program
*)

(*
     This example is brought to you for the purposes of exploration and experimentation in
   System 7.0.  It is not intended to form the basis of your own programs- but try out
   the code - that's what it's there for
*)

{

    Known problems-:

    System 7.0 specifics-:
        Saving a file using a temporary filename generated using a random file name.
        Note the use of PBExchangeFiles to make sure that the FileID of the new file is the
        same as the old one.
}
(*
    Changes for 3.0d2 :
        19-Feb-92    : NH : Fix open of doc with no other docs open and has
                         published sections.
      18-Mar-92    :    NH : AssocAllSections called after SaveAs
        27-Mar-92    : NH : Arrow Cursor on alerts
                     Comment file some more
      28-Mar-92 : NH : GetFileNameToSaveAs - return FALSE if cancelled (was TRUE!)

    Changes for 3.0d3:

      24-Jun-92 : NH : Deleted unused vars in DoSave,
                         Changed kAEAskUser to kAEAsk

        26-Jun-92 : NH : Use FSpOpenDF and remove PBHOpen/Zero, make OpenOld return
                         error code.

*)
  INTERFACE

    USES MemTypes, QuickDraw, OSIntf, ToolIntf, Traps, Files, Packages, Editions,AppleEvents,Printing,

                 SVEditGlobals, SVEditUtils, SVEditions, SVEditWindow;

    PROCEDURE DoQuit(saveOpt:DescType);

    FUNCTION DoClose(aWindow: WindowPtr; canInteract:Boolean; dialogAnswer:DescType): OSErr;

    FUNCTION GetFileNameToSaveAs(theDocument:DPtr): OSErr;

    FUNCTION DoSave(theDocument : DPtr;
                                        theFSSpec        : FSSpec): OSErr;

    FUNCTION GetFileContents(theFSSpec: FSSpec; theDocument:DPtr): OSErr;

    PROCEDURE FileError(s, f: STR255);

    FUNCTION SaveUsingTemp(theDocument:DPtr): OSErr;

    FUNCTION OpenOld(aFSSpec: FSSpec): OSErr;

    FUNCTION OpenUsingAlias(theAliasH: AliasHandle): OSErr;

    FUNCTION GetFile(VAR theFSSpec: FSSpec): OSErr;

    {-----------------------------------------------------------------  }
    { Implementation part                                               }
    {-----------------------------------------------------------------  }

  IMPLEMENTATION
        USES AERegistry;

{*-----------------------------------------------------------------------
        Name:             FileError
        Purpose:        Puts up an error alert.
    -----------------------------------------------------------------------*}

    {$S File}

    PROCEDURE FileError(s, f: STR255);

      VAR
        alertResult : INTEGER;
                myErr       : OSErr;

      BEGIN
                myErr := AEInteractWithUser(kAEDefaultTimeOut,
                                                                        NIL,
                                                                        NIL);
        IF (myErr=noErr) THEN
                    BEGIN
                        SetCursor(arrow);
                        ParamText(s, f, '', '');
                alertResult := Alert(errorAlert, NIL);
                    END;
      END;

{*-----------------------------------------------------------------------
        Name:             DoClose
        Purpose:        Closes a window.
    -----------------------------------------------------------------------*}

    {$S File}
        FUNCTION DoClose(aWindow : WindowPtr; canInteract : Boolean; dialogAnswer : DescType):OSErr;
            VAR
                aDocument    : DPtr;
                alertResult  : INTEGER;
                theName      : Str255;
                myErr        : OSErr;

            BEGIN
                myErr := noErr;

                IF (gWCount>0) THEN
                    BEGIN
                        aDocument := DPtrFromWindowPtr(aWindow);

                        IF (aDocument^.dirty) THEN
                            IF (canInteract AND (dialogAnswer=kAEAsk)) THEN
                                BEGIN
                                    IF (aDocument^.everSaved = false) THEN
                                        GetWTitle(aWindow, theName) (* Pick it up as a script may have changed it *)
                                    ELSE
                                        theName := aDocument^.theFileName;

                                    ParamText('Save Changes for ', theName, '', '');
                                    SetCursor(Arrow);
                                    alertResult := Alert(AdviseAlert, nil);
                                    CASE alertResult OF
                                        aaSave  : IF (aDocument^.everSaved = false) THEN
                                                                BEGIN
                                                                    myErr := GetFileNameToSaveAs(aDocument);
                                                                    IF (myErr = noErr) THEN
                                                                        myErr := DoSave(aDocument, aDocument^.theFSSpec);

                                                                    IF (myErr = noErr) THEN
                                                                        AssocAllSections(aDocument);
                                                                END
                                                            ELSE
                                                                myErr := SaveUsingTemp(aDocument);

                                        aaCancel : myErr := userCanceledErr;

                                        aaDiscard: aDocument^.dirty := false;
                                    END
                                END
                            ELSE
                                BEGIN
                                    IF (dialogAnswer = kAEYes) THEN
                                        IF (aDocument^.everSaved = false) THEN
                                            BEGIN
                                                IF (canInteract) THEN
                                                    BEGIN
                                                        myErr := GetFileNameToSaveAs(aDocument);
                                                        IF (myErr = noErr) THEN
                                                            myErr := DoSave(aDocument, aDocument^.theFSSpec);

                                                        IF (myErr=noErr) THEN
                                                            AssocAllSections(aDocument);
                                                    END
                                                ELSE
                                                    myErr := errAENoUserInteraction;
                                            END
                                        ELSE
                                            myErr := SaveUsingTemp(aDocument)
                                    ELSE
                                        myErr := noErr; (* Don't save *)
                                END;

                        IF (myErr=noErr) THEN
                            BEGIN
                                IF (aDocument^.numSections<>0) THEN
                                    DeRegisterAllSections(aDocument);
                                CloseMyWindow(aWindow);
                            END;
                    END
                ELSE
                    myErr := errAEIllegalIndex;

                DoClose := myErr;
            END;

        {$S File}
        (*
                DoQuit
                saveOpt - one of kAEAsk,kAEYes,kAENo
                if kAEYes or kAEAsk then AEInteactWithUser should have been called
                before DoQuit. Assumes that it can interact if it needs to.
        *)

    PROCEDURE DoQuit(saveOpt : DescType);

      VAR
        aWindow       : WindowPtr;
        nextWindow    : WindowPtr;
        nextWPeek     : WindowPeek;
        theKind       : INTEGER;
        check         : OsErr;

      BEGIN
        aWindow := FrontWindow;
        WHILE aWindow <> NIL DO
          BEGIN
            nextWPeek := WindowPeek(aWindow)^.nextWindow;
            nextWindow := @nextWPeek^.port;
            IF Ours(aWindow) THEN
              BEGIN
                check := DoClose(aWindow, TRUE, saveOpt);
                IF check<>noErr THEN
                  exit(DoQuit);
              END
            ELSE
              BEGIN
                theKind := WindowPeek(aWindow)^.windowKind;
                IF theKind < 0 THEN
                  CloseDeskAcc(theKind);
              END;
            aWindow := nextWindow;
          END;     {WHILE/DO loop}
        gQuitting := TRUE;
      END;

    FUNCTION GetFile(VAR theFSSpec: FSSpec): OSErr;
      VAR
        myTypes  : SFTypeList;
        reply    : StandardFileReply;
                myErr       : OSErr;

      BEGIN
                myErr := noErr;

        myTypes[0] := 'TEXT';

        StandardGetFile(NIL, 1, myTypes, reply);

        IF (reply.sfGood) THEN
                    theFSSpec := reply.sfFile
        ELSE
          myErr := userCanceledErr;

                GetFile := myErr;
      END;

    {$S File}

    FUNCTION DoCreate(theSpec: FSSpec): OSErr;

      VAR
        err           : OSErr;

      BEGIN

        err := FSpCreate(theSpec, 'SVED', 'TEXT', smSystemScript);

        DoCreate := err;
        IF err <> noErr THEN
          ShowError('DoCreate', err);
      END;

    {$S File}

    FUNCTION WriteFile(theDocument : DPtr;
                                             refNum             : INTEGER;
                       theFSSpec     : FSSpec): OSErr;

      VAR
        resFile       : INTEGER;
        length        : LONGINT;
        theHHandle    : HHandle;
        theSHandle    : StScrpHandle;
        err           : OSErr;
        theAppName    : StringHandle;
                oldSelStart   : INTEGER;
                oldSelEnd     : INTEGER;
                thePHandle    : Handle;

      BEGIN
        WriteFile := 1;

        {first write out the text to the data fork}
        length := theDocument^.theText^^.teLength;
        HLock(theDocument^.theText^^.hText);
        IF FSWrite(refNum, length, theDocument^.theText^^.hText^) <> noErr THEN
          exit(WriteFile);
        HUnlock(theDocument^.theText^^.hText);

        {we are writing to a temporary file, so we need to create the resource file}
        {before writing out the resources}
        {now open the resource file}

        WITH theFSSpec DO
          BEGIN
            HCreateResFile(vRefNum, parID, name);
            err := ResError;
            IF err <> noErr THEN
              BEGIN
                ShowError('HCreateResFile', err);
                exit(WriteFile);
              END;

            resFile := HOpenResFile(vRefNum, parID, name, fsWRPerm);
            err := ResError;

            IF err <> noErr THEN
              BEGIN
                ShowError('HOpenResFile', err);
                exit(WriteFile);
              END;

          END;

        {write out our 'TFSF' resource to file}

                oldSelStart := theDocument^.theText^^.selStart;
                oldSelEnd   := theDocument^.theText^^.selEnd;
                TESetSelect(0,32000, theDocument^.theText);

        theSHandle := GetStylScrap(theDocument^.theText);

                TESetSelect(oldSelStart,oldSelEnd, theDocument^.theText);

        AddResource(Handle(theSHandle), 'TFSF', 255, 'Style Info');
        err := ResError;

        IF err <> noErr THEN
          BEGIN
            ShowError('AddResource- TFSF', err);
            exit(WriteFile);
          END;

                { write out the printer info }

                IF (theDocument^.thePrintSetup<> NIL) THEN
                    BEGIN
                        thePHandle := Handle(theDocument^.thePrintSetup);
                        err := HandToHand(thePHandle);

                AddResource(thePHandle, 'TFSP', 255, 'Printer Info');

                        err := ResError;

                        IF err <> noErr THEN
                            BEGIN
                                ShowError('AddResource- TFSS', err);
                                exit(WriteFile);
                            END;
                    END;


        theHHandle := HHandle(NewHandle(SizeOf(HeaderRec)));
        HLock(Handle(theHHandle));

        GetFontName(theDocument^.theFont, theHHandle^^.theFont);
        theHHandle^^.theSize     := theDocument^.theSize;
        theHHandle^^.theStyle    := theDocument^.theStyle;
        theHHandle^^.lastID      := theDocument^.lastID;
        theHHandle^^.numSections := theDocument^.numSections;

        HUnlock(Handle(theHHandle));

        AddResource(Handle(theHHandle), 'TFSS', 255, 'Header Info');

        err := ResError;

        IF err <> noErr THEN
          BEGIN
            ShowError('AddResource- TFSS', err);
            exit(WriteFile);
          END;

        {if we have any sections, write out the records and resources}
        IF theDocument^.numSections <> 0 THEN
          BEGIN
            {now write out the section records}
            SaveSections(theDocument);

                        {write the latest versions of all editions to their containers}

            WriteAllEditions(theDocument);
            {now close the resource file}
            err := ResError;
            IF err <> noErr THEN
              BEGIN
                ShowError('CloseResFile', err);
                exit(WriteFile);
              END;
          END;

        {Now put an AppName in for Finder in 7.0}

        theAppName := StringHandle(NewHandle(6));
        theAppName^^ := '7Edit';
        AddResource(Handle(theAppName), 'STR ', - 16396, 'Finder App Info');

        err := ResError;

        IF err <> noErr THEN
          BEGIN
            ShowError('AppName', err);
            exit(WriteFile);
          END;

        CloseResFile(resFile);

        WriteFile := noErr;
      END;

    {$S File}

    FUNCTION ReadFile(theDocument    : DPtr;
                                            refNum            : INTEGER;
                      fn                    : STR255): OSErr;

      VAR
        theSize       : LONGINT;
        resFile       : INTEGER;
        err           : INTEGER;
        aHandle       : HHandle;
                gHandle                : Handle;

      BEGIN
        ReadFile := 1;

        IF GetEOF(refNum, theSize) <> noErr THEN
          exit(ReadFile);

        {we're only using TE, so check that there is not more than 32K worth of text}

        IF theSize > 32000 THEN
          exit(ReadFile);

        gHandle := NewHandle(theSize);
        HLock(gHandle);
                err := FSRead(refNum, theSize, gHandle^);

        IF err <> noErr THEN
          BEGIN
            HUnlock(gHandle);
                        ReadFile := err;
            exit(ReadFile);
          END;

        WITH theDocument^.theFSSpec DO
          BEGIN
            resFile := HOpenResFile(vRefNum, parID, fn, fsWRPerm);
                        IF resFile = -1 THEN
                err := fnfErr;
          END;

                theDocument^.numSections := 0;

                IF (err=noErr) THEN
                    BEGIN
                        aHandle := NIL;

                        IF Count1Resources('TFSS') <> 0 THEN
                            aHandle := HHandle(Get1Resource('TFSS', 255));

                        IF (aHandle <> NIL) THEN
                            theDocument^.numSections := aHandle^^.numSections;

                        (*
                            New Format Info
                        *)

                        aHandle := NIL;
                        IF Count1Resources('TFSF') <> 0 THEN
                            aHandle := HHandle(Get1Resource('TFSF', 255));

                        HLock(gHandle);
                        TEStylInsert(    gHandle^,
                                                    GetHandleSize(gHandle),
                                                    StScrpHandle(aHandle),
                                                    theDocument^.theText);

                        HUnlock(gHandle);

                        (*
                            If there is a print record saved, ditch the old one
                            created by new document and fill this one in
                        *)
                        IF Count1Resources('TFSP') <> 0 THEN
                            BEGIN
                                IF (theDocument^.thePrintSetup <> NIL) THEN
                                    DisposHandle(Handle(theDocument^.thePrintSetup));

                                theDocument^.thePrintSetup := THPrint(Get1Resource('TFSP', 255));
                              err := HandToHand(Handle(theDocument^.thePrintSetup));

                                IF PRValidate(theDocument^.thePrintSetup) THEN;
                            END;

                        IF theDocument^.numSections <> 0 THEN
                            BEGIN
                                ReadSectionRecords(theDocument);
                                ReadAllSectionResources(theDocument);
                            END;

                        CloseResFile(resFile);

                        err := ResError;
                        IF err <> noErr THEN
                            BEGIN
                                ShowError('read file- CloseResFile', err);
                                exit(ReadFile);
                            END;
          END
                ELSE
                    TESetText(gHandle^, GetHandleSize(gHandle), theDocument^.theText);

                IF (gHandle<>NIL) THEN
                    DisposHandle(gHandle);

                IF err=fnfErr THEN
                    err := noErr;

        ReadFile := noErr;
      END; (* ReadFile *)

{* -----------------------------------------------------------------------
        Name:             GetFileContents
        Purpose:        Opens the document specified by theFSSpec and puts
                                the contents into theDocument.
     -----------------------------------------------------------------------*}

    {$S File}

    FUNCTION GetFileContents(theFSSpec: FSSpec; theDocument:DPtr): OSErr;

      VAR
        err           : OSErr;
        theRefNum     : INTEGER;

      BEGIN
        GetFileContents := 1; {if it gets through it is set to noErr}
        {this can be called from two places- on an OpenDoc AppleEvent}
        {and by the user just selecting Open from the File Menu}
        {assume that the CFS is correct when the routine is called}

        err := FSpOpenDF(theFSSpec,
                                 fsRdWrPerm,
                                                 theRefNum);
        IF err <> noErr THEN
          BEGIN
            GetFileContents := err;
            ShowError('FSpOpenDF', err);
            exit(GetFileContents);
          END
        ELSE
          BEGIN
            IF ReadFile(theDocument, theRefNum, theFSSpec.name) <> noErr THEN
              BEGIN
                ShowError('ReadFile', err);
                exit(GetFileContents);
              END;
            IF FSClose(theRefNum) <> noErr THEN
              BEGIN
                ShowError('FSClose', err);
                exit(GetFileContents);
              END;
            GetFileContents := noErr;
          END;
      END;

    {$S File}

    FUNCTION SaveUsingTemp(theDocument : DPtr) : OSErr;
        VAR
            tempName   : Str255;
            err        : OSErr;
            tempFSSpec : FSSpec;

        BEGIN
            (*save the file to disk using a temporary file*)
            (*this is the recommended way of doing things*)
            (*first write out the file to disk using a temporary filename*)
            (*if it is sucessfully written, exchange the temporary file with the last one saved*)
            (*then delete the temporary file- so if anything goes wrong, the original version is still there*)
            (*first generate the temporary filename*)

            GetTempFileName(theDocument, tempName);
            (*create this file on disk*)

            tempFSSpec      := theDocument^.theFSSpec;
            tempFSSpec.name := tempName;

            err := DoCreate(tempFSSpec);

            (*now save the file as normal*)

            IF (err=noErr) THEN
                err := DoSave(theDocument, tempFSSpec);

            IF (err = noErr) THEN
                err := FSpExchangeFiles(tempFSSpec, theDocument^.theFSSpec);

            (*we've exchanged the files, now delete the temporary one*)

            IF (err = noErr) THEN
                err := FSpDelete(tempFSSpec);

            SaveUsingTemp := err;
        END;

    {$S File}

    FUNCTION GetFileNameToSaveAs(theDocument:DPtr): OSErr;
            (*
                Fills in the document record with the user chosen destination
            *)

      VAR
        reply         : StandardFileReply;
        err           : OSErr;
                suggestName   : Str255;

      BEGIN
                GetWTitle(theDocument^.theWindow, suggestName);

        StandardPutFile('Save Document As:', suggestName, reply);

        IF reply.sfGood THEN
          BEGIN
                err := FSpDelete(reply.sfFile);

                        IF (err=fnfErr) THEN
                            err := noErr;

                        IF (err = noErr) THEN
                            BEGIN
                                theDocument^.theFSSpec   := reply.sfFile;
                                theDocument^.theFileName := reply.sfFile.name;
                            END;
          END
                ELSE
                    err := userCanceledErr;

                GetFileNameToSaveAs := err;
      END; (* GetFileNameToSaveAs *)

    {$S File}

    FUNCTION DoSave(theDocument : DPtr;
                    theFSSpec        : FSSpec): OSErr;

      VAR
        refNum        : INTEGER;
                fileErr                : OSErr;

      BEGIN
        DoSave := noErr;

                fileErr := FSpOpenDF(theFSSpec, fsRdWrPerm, refNum);

                IF (fileErr = fnfErr) THEN
                    BEGIN
                        fileErr := DoCreate(theFSSpec);

            IF (fileErr<> noErr) THEN
              BEGIN
                                DoSave := fileErr;
                                Exit(DoSave);
                            END;

                        fileErr:= FSpOpenDF(theFSSpec, fsRdWrPerm, refNum);
                    END;

        IF (fileErr = noErr) THEN
          BEGIN
                        fileErr := WriteFile(theDocument, refNum, theFSSpec);

            IF (fileErr = noErr) THEN
                            theDocument^.dirty := FALSE;

                        fileErr := FSClose(refNum);
          END
        ELSE
          FileError('error opening file ', theFSSpec.name);

          DoSave := fileErr;
            END;

    {$S File}

    FUNCTION OpenOld(aFSSpec: FSSpec):OSErr;
            VAR theDocument : DPtr;
                    myErr       : OSErr;

      BEGIN
        theDocument := NewDocument(TRUE);

                SetWTitle(theDocument^.theWindow, aFSSpec.name);

                SetPort(theDocument^.theWindow);

        theDocument^.theFSSpec   := aFSSpec;
        theDocument^.theFileName := aFSSpec.name;
        theDocument^.dirty       := FALSE;
                theDocument^.everSaved   := TRUE;

        myErr := GetFileContents(aFSSpec, theDocument);
                IF (myErr = noErr) THEN
          BEGIN
                         ResizeWindow(theDocument);
                        ShowWindow(theDocument^.theWindow);
                    END
        ELSE
          BEGIN
                        FileError('Error Opening ', aFSSpec.name);
                    END;

                OpenOld := myErr;

      END;

    {$S File}

    FUNCTION OpenUsingAlias(theAliasH: AliasHandle): OSErr;

      VAR
        err           : OSErr;
        aFSSpec       : FSSpec;
        dummy         : BOOLEAN;

      BEGIN
        OpenUsingAlias := noErr;
        err := ResolveAlias(NIL, theAliasH, aFSSpec, dummy);
        IF (err = noErr) THEN
          err := OpenOld(aFSSpec);

        OpenUsingAlias := err;
      END;

END.